home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0146_TRON Game.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  4KB  |  141 lines
  1. (* Just one of the (dozens) of possible ways of doing the old Tron game in *)
  2. (* Pascal... Have fun!                                                     *)
  3. (* Two players only. Cursor keys, and O, P, Q, R                           *)
  4. (* Freeware - 1994 - Luis Evaristo Beda Netto Marques da Fonseca           *)
  5. (* Thunderball Software Inc.                                               *)
  6.  
  7. Program Tron;
  8.  
  9. Uses Graph,Crt;
  10.  
  11. Var Cpos1,Lpos1,Cpos2,Lpos2,Npos1,Npos2,Winner,Vel,Ngames:Integer;
  12.     Conta,Bluep,Yellowp:Integer;
  13.     Out:Boolean;
  14.     Exitgame:Char;
  15.  
  16. Procedure Initg;                      {initialize graphics}
  17. var gd,gm:integer;
  18. Begin
  19.     Gd:=detect;
  20.     Initgraph(Gd,Gm,'C:\TP\BGI');
  21. End;
  22.  
  23. Procedure InitVar(Var Cpos1,Lpos1,Cpos2,Lpos2,Npos1,Npos2:Integer;Var out:Boolean);
  24. Begin                                   {initilize game variables}
  25.     Npos1:=3;
  26.     Npos2:=1;
  27.     Lpos1:=240;
  28.     Lpos2:=240;
  29.     Cpos1:=370;
  30.     Cpos2:=270;
  31.     out:=False;
  32. End;
  33.  
  34. Procedure PressKey(Var Npos1,Npos2:Integer);
  35. Var Ch:Char;
  36.     Num:Integer;
  37. Begin
  38. If Keypressed then                              {get the key pressed and}
  39.     Ch:=ReadKey;                                 {change course accordingly}
  40.     if Ch=#0 then
  41.     begin
  42.         Ch:=ReadKey;
  43.         Num:=Ord(Ch);
  44.         Case Num of
  45.             75:If Npos1<>3 then Npos1:=1;
  46.             72:If Npos1<>4 then Npos1:=2;
  47.             77:If Npos1<>1 then Npos1:=3;
  48.             80:If Npos1<>2 then Npos1:=4;
  49.         End;
  50.     End
  51.     Else
  52.     Begin
  53.         Num:=Ord(Ch);
  54.         Case Num of
  55.             111:If Npos2<>3 then Npos2:=1;
  56.             113:If Npos2<>4 then Npos2:=2;
  57.             112:If Npos2<>1 then Npos2:=3;
  58.              97:If Npos2<>2 then Npos2:=4;
  59.         End;
  60.     end;
  61. End;
  62.  
  63. Procedure ScrnOutput(Npos1,Npos2:integer;Var Lpos1,Lpos2,Cpos1,Cpos2,Winner,Vel:Integer; Var out:Boolean);
  64. Var Color:Word;
  65. Begin
  66.      Case Npos1 of                              {write output at screen and}
  67.           1:Cpos1:=Cpos1-1;                     {actualize position variables}
  68.           2:Lpos1:=Lpos1-1;
  69.           3:Cpos1:=Cpos1+1;
  70.           4:Lpos1:=Lpos1+1;
  71.      End;
  72.      Color:=GetPixel(Cpos1,Lpos1);
  73.      If Color<>0 then
  74.      Begin
  75.         out:=true;
  76.         winner:=2;
  77.      End;
  78.      Color:=Cyan;
  79.      PutPixel(Cpos1,Lpos1,Color);
  80.      Case Npos2 of
  81.           1:Cpos2:=Cpos2-1;
  82.           2:Lpos2:=Lpos2-1;
  83.           3:Cpos2:=Cpos2+1;
  84.           4:Lpos2:=Lpos2+1;
  85.      End;
  86.      Color:=GetPixel(Cpos2,Lpos2);
  87.      If Color<>0 then
  88.      Begin
  89.         out:=true;
  90.         winner:=1;
  91.      End;
  92.      Color:=Yellow;
  93.      PutPixel(Cpos2,Lpos2,Color);
  94.      Delay(Vel);
  95. End;
  96.  
  97. Begin
  98. exitgame:='Y';
  99. While Upcase(exitgame)='Y' do
  100. Begin
  101.      yellowp:=0;
  102.      bluep:=0;
  103.      Clrscr;
  104.      Writeln('Choose speed (1-very fast to 100-really slow):');
  105.      Readln(Vel);
  106.      Writeln('Choose number of games:');
  107.      Readln(ngames);
  108.      if not odd(ngames) then
  109.      begin
  110.          writeln('Only odd numbers are accepted. Adding one.');
  111.          inc(ngames);
  112.          readln;
  113.      end;
  114.      For Conta:=1 to ngames do
  115.      Begin
  116.           Initg;
  117.           InitVar(Cpos1,Lpos1,Cpos2,Lpos2,Npos1,Npos2,out);
  118.           SetColor(Blue);
  119.           Rectangle(0,0,639,479);
  120.           While out=False do
  121.           Begin
  122.                Presskey(Npos1,Npos2);
  123.                ScrnOutput(Npos1,Npos2,Lpos1,Lpos2,Cpos1,Cpos2,winner,Vel,out);
  124.           End;
  125.           Clrscr;
  126.           If winner=1 then
  127.               bluep:=bluep+1
  128.           else
  129.               yellowp:=yellowp+1;
  130.      Closegraph;
  131.      End;
  132.      Write('And the winner is the ');
  133.      if bluep>yellowp then
  134.          Write('blue')
  135.      else
  136.          Write('yellow');
  137.      writeln(' player!');
  138.      Write('New game? (Y/N): ');
  139.      Readln(exitgame);
  140. End;
  141. End.